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introduction 

This document represents a progress report of our research on 
the qrant (NAG 5-2375) from NASA between March 1, 1995 and November 
30 1995 During this reporting period our laboratory 

concentrations consisted of several parts; (1) We made several 
presentations of the work sponsored by NASA covered under the la 
status report period. (2) We irradiated and successfully completed 
Moessbauer measurements on a high temperature 

We continued the improvement of our laboratory with the develop 
of improved software and (4) we made modifications of equipment to 
increase the efficiency and decrease the time necessary for 
completing an experimental investigation. In add^ to our 

research results, this report contains a copy of the last financia 
report submitted by the University's business office that was 
related to this grant. It shows the expenditures as of September 
30, 1995. We plan to expend all of the funds by the end of the 
grant period. 

RESULTS OF INVESTIGATIONS 


Irradiation Studies m ...ip 

High temperature superconductors have made large 
technical applications a possible reality. However, they have some 
limitations. Among them are their limited critical currents a n w 
current density. Previous experimental work indicated that 
irradiation by Neutrons were effective in increasing the measured 
current density while reducing current density anisotropy and 
transition temperatures. Continued research in this area may 
ultimately yield a high temperature superconductor with a high 
enoigh current density that it becomes practical m technical 
applications . We wanted to see if we could use Moessbauer 
spectroscopy to see if we could observe any changes in the 
irradiated superconductors and to interpret the causes of the 
observations We chose to look at the Moessbauer parameters 

linewidth and isomer shift. The linewidth gives one an indication 
of the number of different sites xn the material and the isomer 
shift is related to the electronic charge density at the nucleus. 

To carry out the above objective one-half of a superconductor 
sample ( EuWu.O,., ) was irradiated by a one curre Plutonium 
beryllium neutron source with approximately 3.45 x 10 neutrons^ 
The other half was used as the control and thus was -not Jeered 
any way. Moessbauer spectra were taken for both hal . 
calculated isomer shift and linewidths for the irradiated and the 


t. 


non- irradiated sample are listed in Table 1. Europium fluoride was 
used as a standard for the isomer shift calculations and iron foil 
was used to calibrate the system. Figures 1 and 2 show the 
Moessbauer spectra of the non- irradiated and irradiated samples 
respectively . 


TABLE 1 

Sample 
EuF 3 

EuBa 2 Cu 3 0 7 . x 

EuBa 2 Cu 3 0 7 . x 
(irradiated) 

The difference between the linewidth ratio of the irradiated and 
non- irradiated samples of EuBa 2 Cu 3 0 7 _ x does not deviate beyond the 
experimental error. This indicates that all the europium atomic 
sites are similar. In the case of the isomer shift however, we see 
a difference that infers that neutron irradiation substantially 
alters its isomer shift. This implies that there is an increase in 
the s electron density at the nucleus of the europium atom This 
results suggests to get a higher current density in superconducting 
materials, one needs to modify the superconductor to increase its 
s electron density. We have requested a larger dosage of neutrons 
from the nuclear reactor at NIST and we are waiting for a reply to 
our request. We want to see what happens for a larger dosage of 
neutrons . 

Phonon Studies 

We reported on our previously observed phonon anomaly (1) in 
a Bi high Tc compound at the March 1995 American Physical Society 
meeting in Washington D.C. (2) . This work indicated that other sites 
besides the commonly accepted copper planes are effected by the 
superconductivity mechanism. 

Particle Size Studies 

In an attempt to gain a better understanding of the cause of 
superconductivity, we were part of a group effort looking at the 
relationship of starting particle size with the final 
superconductor. We wanted to see if there was any relationship 
between starting particle size and the Moessbauer parameters of 
linewidth and isomer shift. Measurements were made on a number of 
EuBa 2 Cu 3 0 7 . x superconductors prepared by a solid state reaction of 
Eu 2 0 3 , BaC0 3 , and CuO powders. The letter designation for each 
particle size was used to name the pellets, with the first letter 
corresponding to Eu 2 0 3 , the second to BaC0 3 , and the third to CuO. 


Linewidth Ratio Isomer shift (mm/ s) 

1 0 
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. 05 

- . 82 + 

. 01 

85 + 

. 05 
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For example, the sample BAB is 100 - 200 mesh size Eu 2 0 3 , above 100 
mesh size BaC0 3 , and 100 - 200 mesh size CuO. The particle size 
relates to the diameter of the particles of that mesh. Table 2 
shows the relationship of particle size and letter designation, 

TABLE 2 - Mesh Sizes and Nomenclature 


Mesh Size 

Letter Designation 

Particle Size 

above 100 

A 

>150 um 

100 - 200 

B 

7 5 um - 15 0 um 

200 - 325 

C 

4 5 um - 75 um 

325 - 400 

D 

3 8 um - 4 5 um 


Spectra were taken in transmission geometry at room temperature in 
the constant acceleration mode and were fitted by a least squares 
lorentzian analysis program. Table 3 shows the linewidth and isomer 
shift for the various superconductors. Europium fluoride was used 
as a standard for isomer shift calculations. Figure 3 shows the 
experimental spectrum for EuF 3 . An iron foil was used to calibrate 
the system and its spectrum is shown in Figure 4 . Figures 5 through 
10 show the Moessbauer experimental data for the various particle 
sizes . 

The experimental results do not show a relationship between 
linewidth and particle size. All of the isomer shifts give the same 
results within experimental error. This is understandable since 
particle size is a macroscopic specification whereas linewidth and 
isomer shift are microscopic applications. Different starting 
particle size does not effect the final product when investigated 
with Moessbauer spectroscopy. This is similar to the conclusion of 
Howard in his study on the relationship between particle size and 
transition temperature for high Tc compounds (3) . A paper including 
this work is being prepared for submission for publication (4) . 

SOFTWARE DEVELOPMENT 

During this reporting period, we developed several new 
computer subroutines to reduce the tedious task of analyzing data. 
We developed a code that generated a least squares fit of the 
parabola that appeared in the Moessbauer spectrum due to the 
changing solid angle the detector sees because of the motion of the 
source, our program strips the parabola off the spectrum. This 
procedure will accelerate the convergence of the lorentzian 
fitting code. Figure 5 is a plot showing the original data along 
with flat data after subtracting the parabola. A copy of this code 
is found in Appendix B. We also developed a code using the graphing 
software called MAT LAB to do the fitting of Moessbauer data. The 
advantage of MAT LAB is that we can now use a pc instead of the 
University's mainframe computer to analyze our experimental data. 
We found this program to give us the same results as that found 
using the mainframe. This capability will free our research 
laboratory form the restrictions imposed by using the University' s 
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computing system. We plan to submit this program for publication in 
a computer physics journal. A copy of this code is found in 
Appendix B. The third major program represents an improvement of 
our computer program for plotting the final plots of experimental 
Moessbauer data. We modified the software provided by the company 
who designed our Moessbauer system (Austin Science) into one that 
plots absorption versus velocity and gives us camera ready spectra 
for publication. A comparison of the two different computer codes 
may be observed by comparing the horizontal axis of figures 3 and 
4 (Austin Science) with Figures 1,2,5,6,7,8,9,10. 


REFERENCES 

1. Oliver, F.W., NASA Annual Report, Oct. 1, 1993-Sept. 30, 1994, 
Grant# NAG 5-2375. 

2. Oliver, F.W., Hoffman, E., Tarleton, D., May, L ., Violet , C . E . , 
and Seehra,M.S., April A.P.S. meeting, Washington, D.C. 

3. Edwards, M.A., Howard, J.W., private communication. 

4. Edwards, M.A., Howard, J. W. , Radcliffe, D., Wynter, C.I., 
Oliver, F.W., et al . , (To be submitted to Physica C) . 
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Sample 


L.W (mm/s) 


L.W Ratio 


I.S 


EuF, 


2.90 ± .05 


BBC 

2.67 ± .05 

.92 

.87 ± .02 

BBA 

2.83 ± .05 

.98 

.78 ± .02 

BBB 

2.92 ± .05 

.99 

.82 ± .02 

BAB 

2.58 ± .05 

.89 

.79 ± .02 

CCD 

2.66 ± .05 

.92 

.82 ± .02 






ABB 


2.61 ± .05 


.90 


.82 ± .02 
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THURSDAY MORNING 


10:00 

no n 

Determination of Gap Distortion and Longitudinal Res- 
onance Frequency in Superfluid 3 He-B. M.R. RAND, D.T. 
SPRAGUE, T.M. HAARD, J.B. KYCIA, P.J. HAMOT, Y. LEE, D.M. 
MARKS, W.P. HALPER1N, Northwestern Ihuvcrsity — We have per- 
formed pulsed transverse nuclear magnetic resonance in superfluid 3 He- 
B. We derived and then numerically solved the Leggett equations for 
the high field limit. From our experiments and our analysis of the 
Leggett equations we have determined the temperature dependence of 
the longitudinal resonance frequency and the distortion of the energy 
gap. Numerical solutions show that the tipping angle dependent pre- 
cession frequency generally differs substantially from the prediction of 
stationary solutions and depends on the magnitude of the transverse tip- 
ping field. However, for tipping angles of 4> < 60° and also for <fi m 125°, 
the precession frequency agrees with the stationary solution, being in- 
sensitive to the magnitude of the tipping field. This work is supported 
by the National Science Foundation through grants DM R-93 14025 and 
DMR-931 1918. 


10:12 

1,0 12 Theory of Pulsed NMR Studies in Solid Efr T. DINESEN, 
B. C. SANCTUARY . Me. Gill U . and H. MEYER. Duke U. Density 
matrix theory is used to calculate the response signal of 0-D2 (with 
rotational angular momentum J=0 and nuclear spin 1=2) in two- and 
three-pulse NMR experiments. A closed-form method has been 
successfully applied 1 ^ to the solid echo properties of 0-H2 and p-D 2 
(both with J=1 and 1=1), but had not previously been developed for the 
1*2 spin system. We find, as expected, similar functional dependence 
upon the experimental parameters of both ortho and para systems and 
arrive at a detailed account of the intermolecular dipolar field. While this 
closed-form method considers individual contributions to the echo 
amplitude, greater physical insight is gained by considering the 
rotational invariance properties of the line shape. Results from a 
spherical tensor and product operator basis are then compared with one 
another as representations of the quadrupolar solid echo response 
problem. Finally the predicted solid echo amplitude ratio of the 1=1 and 
1=2 components, expressed as a function of the time t between the 
pulses and their respective phases 0, is compared with that observed 1 ) 
for several D2 crystals of various J=1 concentrations. We also discuss 
the satellite echoes, predicted for the 1=2 system, which have been 
observed 2 ) in D2 adsorbed on MgO but not 1 ) in solid D2. 

1) I.Yu et al. . J. Low Temp. Physics 51, 369 (1983) for H2 . 

D. Clarkson, X. Qin and H. Meyer, J. Low Temp. Physics 91, 
119(1993) for D 2 . 

2) M.P. Volz et al. Phys. Rev. Lett. 63, 2582 (1989) 


SESSION 111: DAMOP: ATOMIC AND MOLECULAR 
STRUCTURE AND SPECTROSCOPY 
Thursday morning, 20 April 1995 
Room 3 at 8:00 
R. Pratt, presiding 


8:00 

111 1 Rovibronic Spectroscopy of the Ethoxy Radical in a Su- 
personic Jet Environment PRAI3HAKAR MISRA. Howard Univer- 
sity — The ethoxy {CqH^O} radical is generated as a chemical inter- 
mediate in combustion and atmospheric processes. Jt belongs to the C a 
point group and has 18 fundamental vibrational frequencies. C^H^O 
was produced in situ bv photolyzing freshly synthesized C^H^ONO 
in a pulsed supersonic expansion with KrF (& 248 nm) excimer laser 
pulses. A frequency-doubled Nd:YAG- pumped dye laser with a nom- 
inal linewidth of 0.07 cm -1 served as the probe beam for excitation 
of the radical. Extensive laser excitation spectra of jet-cooled C 2 // 5 O 
have been recorded in the 310-350 nm region with 0.15 cm " 1 resolution. 
Wavelength-resolved emission spertra have also been obtained with an 
Optica] Multichannel Analyzer system, which employed ('CD detection 


in conjunction with a 0.275 m monochromator equipped with a 1200 
grooves/mm grating that provided a resolution of 0.5 nm. Several new 
vibrational frequencies have been identified for the C 2 // 5 O radical. 

^Supported by EPA grant R81-9720-010. NASA grant NAG3-1G77 and 
CSTEA (NAGW-2950). 


8:12 

1112 lsl Eu Mossbauer Investigation on a Bismuth Hich-T^ 
Superconductor . F. W. Oliver, E. Hoffman, D. Tarieton, Morgan 
Slate Urn,, L. May, The Catholic Uni of America. C.E. Violet, 
LLNL . and M. S. Seehra, West Virginia Univ. We report on 
Mossbauer studies on Bismuth high -temperature superconductors 
with a particular emphasis on our findings on the superconductor 
Bi2Cao.5Euo.5Si2Cu20 x using Magnetic susceptibility 

measurements show a transition temperature of 87 K. Mossbauer 
measurements were performed between liquid nitrogen and room 
temperature. Isomer shift measurements show the Eu to be 
trivalent and is similar to those found for Eu based 1,2,3 high-T c 
superconductors. Evidence of phonon softening is observed about 
the Eu atom during transition to the superconducting state. A 
discussion on the isomer shift and f factor as a function of 
temperature will be reported and compared with previous results 
found in Eu based high-T c superconductors. 


Supported by NASA - NAG 5-2375. 


8:24 

1113 

Microwave Dielectric Behavior of Transition 
Metal Oxides . J, N. DAHIYA, Southeast Missouri 
State University . — A microwave resonant cavity 
in the TE 0U mode is used to study the 
dielectric properties of a sample of cobalt 
oxide and nickel oxide. The microwave data of 
these crystals is taken as a function of 
frequency and temperature. A fixed length of 
the sample is inserted into the resonant 
cavity and the perturbation of the signal are 
recorded in terms of the frequency shifts and 
width changes. Slater's perturbation 
equations are used to calculate the real and 
imaginary parts of the complex dielectric 
constant. A very sensitive heating and 
cooling technique is used to study the 
dielectric behavior of these crystals at 
various temperatures. Debye's theory is used 
to calculate the relaxation times of these 
crystals. 

Supported by a grant from Grants and Research 
Funding Committee at Southeast Missouri State 
University. 


8:36 

1114 Quantized Magnetic Flux in Atomic Systems . R L 

COLLINS, retired . HCOl Box 106C. Rockport. TX 78382 - 
Magnetic flux within a superconducting ring is quantized in units of 
dNh/le (1,2) This same flux quantum also plays a role within atomic 
systems. An oscillating charge "q” creates, about itself, an encircling 
and transient magnetic field. The Schrodinger equation requires 
correction of the <p> operator, -i(h/27i)V becoming -i(h/27i)V-qA 
(where A is the vector potential) Following Feynman (3), a wave 
function written as v F(r)=[p(r)] l/2 exp[i0(r)] leads to a current density 
J=(h/27im)(V0-(27cq/h)A)p or mv=(h/27t)V0-qA. On integrating this 
last equation along the displacement between turning points of the 
motion, the magnetic flux <t> is readily obtained The first term is 


Vol. 40, No. 2 (1995) ( BaU . APS) 


998 IS. 



Abstract Submittal 
for the March 1996 Meeting 
of The American Physical Society 
18-22 March 1996 


Sorting Category: 16. (b) 


A Mossbauer Study of the Effects of Neutron Irradiation on a 
Hi gh Temperature Superconductor . F. W. OLIVER, E. HOFFMAN, 
D. SEIFU, E. HAMMOND, F. PIERRE, Z. KUREISHY, Morg an 
State Univ.. Balto.. MD . J. HOWARD, Hofstra University, 
Hempstead. N.Y. . C. WYNTER, Nassau Community Collet 
Nassau. N.Y . It has been found that neutron irradiation of high 
temperature superconductors change properties of the material!*^. We 
report on a Mossbauer investigation of neutron irradiated 
EuBa2Cu30 x using the 21.53 kev transition of 151 Eu. A sample was 
irradiated with approximately 3.5 x 10^ neutrons and a comparison 
made of the Mossbauer parameters for the irradiated and non- 
irradiated samples. Experimental results showed no difference 
between line-widths for this level of radiation but a measurable effect 
was seen for the isomer shift A discussion of the isomer shift will be 
reported and compared with previous results found on irradiated low 
temperature superconductors. 


1. B. Roas, B. Hensel, G. Saemann-Ischenko, and L. Schultz, Appl. 
Phys. Lett, 54(11), (March, 1989) p.1051. 

2. J.-W. Lee, H.S. Lessure, D.E. Laughlin, M.E. McHenry, and S. G. 
Sankar, J. O. Willis, J.R. Cost, and .M. Maley, Appl. Phys. 

Lett. 57(20) (November, 1990) p.2150. 


Supported by NASA - NAG 5-2375 


Frederick W, Oliver 

Department of Physics 
Morgan State University 
Baltimore, Maryland 21239 


(X) Prefer Poster Session 
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% MOSS.m 

% This is a matlab version of parabola-lorentzian 
% least-squares analysis of Mossbauer data. 

% 

% 


clear(’L’, ’M'/aa’/bb'/chisq’, 'count 1 , ’delta’/ee’, 'ff ,'gama\ , gg , , , hh , , , i , , l i 1 Vk’/k 1 7k27k37k47mm7n 1 ’ 
k'/pp'/qq'/qqsq'/tt'/width'/xVxmppsq'/xp'/xpsq'/xsq'/y'/ymax'/ymin’/yt'/zz') 


%#544 FE Foil 
nd = 480; 

L = 4; 

bb(l) = 9.10 ; bb(2) = 8.41;bb(3) = 8.60; bb(4) = 8.73; 

pp(l) = 86.73; pp(2) = 204.86; pp(3) = 301 .72; pp(4) = 415.77; 

M = zeros(48,10); 

M = [ 48 X 10 ]; 

x=l:l:nd; 

%y = zeros(nd); 

y = reshape(M', 1,480); 

chisq=l ; 

ymin = y(l); 
ymax = y(l); 
for i=2:nd; 
if y(i)<ymin 
ymin=y(i); 
end 

if y(i)>ymax 
ymax=y(i); 
end 
end 

yminbs = ymin; 
ymaxbs = ymax; 

y = (y - ymin)./(ymax - ymin); 
x = (x - 1 )./(nd- 1 .); 

pp = (pp- l.)/(nd-l.) 
bb = bb/(nd-l.) 

hh = l./(bb. A 2) 


,'n2'.'n3','nd','nn','pea 
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count = I 


while (count) < 14 

count = count + 1 

for i=l:nd; 
for k=l:L; 
xp(k,i)=x(i)-pp(k); 
xpsq(k,i)=xp(k,i) A 2; 
qq(k,i)=l +hh(k).*xp(k,i). A 2; 
qqsq(k,i)-qq(k,i) A 2; 
end 
end 

%tt = zeros(3+3*L,nd); 
for i 1=1 :nd; 
for kl=0:L-l; 

tt(l+3*kl,il) =l./qq(l+kl,il); 

tt(2+3*k 1 ,i 1 )=xp( 1 +k 1 ,i 1 )./qqsq( 1 +k 1 ,i 1 ); 

tt(3+3*k 1 ,il )=xpsq(l+k 1 ,i 1 )./qqsq( 1 +k 1 ,i 1 ); 

end 

end 

for il = l:nd; 
tt(4+3*(L-l),il)= 1; 
tt(5+3*(L-l),il)= x(il); 
tt(6+3*(L-l),il)= x(il) A 2; 
end 


mm = zeros(3*L+3,3*L+3); 
for nl = l :3*L+3; 
for n2=l:3*L+3; 

mm(nl,n2) - sum(tt(n2,:).*tt(nl,:)); 


end 

end 

%nn = zeros(3*L+3,l ); 
for n3=l:3*L+3; 

nn(n3,l) =sum(y.*tt(n3,:)); 

end 

%det(mm) 

zz = inv(mm)*nn; 

for k2=l:L; 

aa(k2) = zz(l+3.*(k2-l)); 

gama(k2) - zz(2+3.*(k2-l))/(2.*aa(k2).*hh(k2)) 

delta(k2) =-zz(3+3.*(k2- 1 »/aa(k2); 

end 

ee = zz(4+3*(L-l)); 
ff = zz(5+3*(L-l)); 



gg = zz(6+3*(L-l)); 


for k3=l:L; 

hh(k3) = hh(k3) + delta(k3); 
pp(k3) = pp(k3) + gama(k3); 
end 

for i=l:nd; 
xsq(i) = x(i). A 2; 
fork4=l:L; 

xmppsq(k4,i) = (x(i) - pp(k4)). A 2; 

end 

end 

yt=(aa(l ,1)7(1 . + hh( 1 , 1 ).*xmppsq( 1 ,:))) + (aa( 1 ,2 )./( 1 . + hh( 1 ,2).*xmppsq(2,:))) + (aa( 1 ,3)./( 1 . + 
hh(l,3)*xmppsq(3,:))) +(aa( 1 ,4)./( 1 . + hh(l,4).*xmppsq(4,:))) + ee + ff.*x + gg.*xsq; 

chisq = sum((y - yt) A 2)./(nd-L) 

yp=ee + ff.*x + gg.*xsq; 

xpmin = - ff./(2.*gg); 

xpminsq = xpmin. A 2; 

ypmin = ee + ff.*xpmin + gg.*xpminsq; 

if (count) <=-l 

y = y - yp + ypmin; 

break 

end 

end 

delta 
gam a 

PP 

hh 

bb=l./sqrt(hh) 

baseline = ee + ff.* xpmin + gg.*xpminsq 

width = bb.*(nd-l.) 
peak = pp.*(nd-l.) + 1. 

cal544 = 2.245 ,/(((peak(2)-peak(i))+(peak(4)-peak(3)))./2.) 

c544 = (peak(2) + peak(3))./2. 

LW544 = bb.*(nd-l.).*cal544 

x = (x - c544./nd).*cal544.*(nd-l.); 

y = (y + yminbs./(ymaxbs - yminbs))./(baseline + yminbs./fymaxbs - yminbs)); 
yt= (yt+ yminbs. /(ymaxbs - yminbs))./(baseline + yminbs./fymaxbs - yminbs)); 

subp!ot(2,l,l) 

plotCx.y.’o'.x.yt); 

legend('data’,'fif) 

titlef’Fe foil 544') 

xlabel(’Velocity [mm/sf) 

ylabel(’Relative Transmission') 

print('plot.ps') 
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cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 


c C 

C THIS CODE GENERATES A LEAST SQUARES QUADRATIC FIT OF THE PARABOLA C 

C THAT APPEARS IN THE MOSSBAUER SPECTRUM WHICH ARISES DUE TO THE C 

C CHANGING SOLID ANGLE THE DETECTOR SEES BECAUSE. OF THE MOTION OF C 

C THE SOURCE AND STRIPS IT OFF THE SPECTRUM. THIS PROCEDURE WILL C 

C ACCELERATE THE CONVERGENCE OF THE LORENTZIAN FITTING CODE. C 

C C 

C D.SEIFU , MORGAN STATE UNIVERSITY SUMMER OF 1995 C 

C C 


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 

c 

IMPLICIT REAL*8 (A-H.O-Z) 

PARAMETER (N=3,NA=512,NB=46,NL=6,NPR=3*NL+1,NF=13) 

DIMENSION A(N,N),INDX(N),B(N),D(N,N),U(N,N),V(N),q(N) 

DIMENSION X(NA),Y(NA),YP(NA),DY(NA),YMP(NA) 

DIMENSION IBAD(NB) 

DIMENSION M(NF),FF(NPR) 

CHARACTER* 80 FIL1,FIL2,FIL3,AA,BB 
C 

WRITE(6,*) 'PLEASE INPUT THE NAME OF THE INPUT FILE.' 

WRITE(6, *)'NOTE THAT THE INPUT FILE SHOULD HAVE A .DAT EXTENSION.' 

READ(5,'(A80)') FIL1 

WRJTE(6,*) 'PLEASE INPUT A NAME FOR A FILE LISTING X,Y AND YP.' 

READ(5,’(A80)') FIL2 
C 

WRITE(6,*) 'PLEASE INPUT A NAME FOR THE OUTPUT FILE.’ 

READ(5,’(A80)') FIL3 

WRITE(6,*) ' THE OUTPUTS WILL IN THE FILE NAMES YOU SPECIFIED WITH 

> AN EXTENSION .DAT 

> 

C 

WRITE(6,*) 'INPUT THE NO. OF CHANNELS TO BE OMITED ON THE LEFT 

> SIDE OF THE MINIMA WHEN CONSTRUCTING THE PARABOLA.' 

READ(5,*) IDL 

WR1TE(6,*) 'INPUT THE NO. OF CHANNELS TO BE OMITTED ON THE RIGHT 

> SIDE OF THE MINIMA WHEN CONTRUCTING THE PARABOLA.’ 

READ(5,*) 1DR 

WRITE(6,*) 'IF THE LIST OF BAD DATA IS AT THE TOP OF THE DATA 

> ENTER 1 ELSE ENTER 2.' 

READ(5,*) LBPT 

C 

OPEN(UNIT=8,FILE= FIL 1 ,STATUS='OLD') 

OPEN(UNIT=6,FILE= FIL2, STATUS-NEW') 

OPEN(UNIT=TO,FILE= FIL3,STATUS=’NEW) 

C 

C READ(8,’(3015)') IBAD 
C READ(8,'(/////)') 

C 

READ(8,'(A80)') AA 
READ(8,'(A80)') BB 
READ(8,'(1 315, f 10.0)') M,F 
READ(8,'(7fl0.2)') FF 
C 
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IF(LBPT.EQ. 1 ) THEN 
READ(8,’(14I5)') IBAD 

READ(8,’(10F7.0) , )Y [read in the values of y from file data.dat 
ELSE 

READ(8,’(I0F7.0)’)Y 
READ(8,'(I4I5)') IBAD 
ENDIF 
C 

111 ND = M(l) 

NBP= M(2) 

C 

WRITE(6,*)'ND =',ND/NBP =*,NBP 
WR1TE(6,*) IBAD 
C 

DO 1 1=1, ND 

X(I) = REAL(l) !set up the value of x (velocity) 

C IF( Y(I).EQ.O.) THEN 
C Y(I) = (Y(I-l) + Y(I+l))/2. 

C ENDIF 

1 CONTINUE 
C 

YMIN=Y(15) 

DO 2 J=2,ND 
DO 23 1=1, NBP 
IF ( J.EQ.IBAD(I)) GOTO 2 
23 CONTINUE 

IF( YMIN.GT.Y(J)) THEN [search for the minimum value of y 
YMIN = Y(J) 

JMIN - J 
ENDIF 

2 CONTINUE 
C 

YMAX=Y(1) 

DO 21 J=2,ND 

IF( YMAX.LT.Y(J)) THEN [search for the maximum value of y 
YMAX - Y(J) 

JMAX = J 
ENDIF 

21 CONTINUE 
C 

WRITE(6,*) ’YMIN-, YMIN, 'YMAX-, YMAX 
WRITE(6,*)'XMIN- , ,X(JMIN);JMIN= , ,JMIN 
C 

DO 22 1=1, ND 

Y(I)= (Y(I) - YMIN)/( YMAX- YMIN) [scaling y to be btn 0 and 1 . 

C X(I)= X(I)/(REAL(ND)) 

22 CONTINUE 
C 

H=YMAX-YMIN 
C 

SYXSQ = 0. 

SXF =0. 

SXC =0. 

SXS =0. 


[initialize the sums used in least squares fit. 



SYX =0. 

SX = 0. 

SY =0. 

c 

DO 3 K.= 1,JMIN-IDL 
DO 3 1 KK=1,NBP 
IF (K.EQ.IBAD(KK)) GOTO 3 
31 CONTINUE 

SYXSQ = SYXSQ + Y(K)*(X(K)**2) 

SXF = SXF + X(K)**4 
SXC =SXC + X(K)**3 

SXS = SXS +X(K)**2 ! calculate the value of the sums 

SYX = SYX + Y(K)*X(K) ! used in the least squares fit. 

SX = SX + X(K) 

SY = SY + Y(K) 

3 CONTINUE 


C 

DO 4 K=JMIN+IDR,ND 
DO 4 1 KK=1,NBP 
IF (K.EQ.IBAD(KK)) GOTO 4 
41 CONTINUE 

SYXSQ = SYXSQ + Y(K)*(X(K)**2) 
SXF = SXF + X(K)**4 
SXC =SXC + X(K)**3 
SXS =SXS + X(K)**2 
SYX = SYX + Y(K)*X(K) 

SX = SX + X(K) 

SY = SY + Y(K) 

4 CONTINUE 
C 

ICB = 0 


C 

DO 45 I=1,JMIN-IDL 
DO 46 11=1, NBP 
IF(I.EQ.IBAD(II)) ICB=ICB + 1 

46 CONTINUE 
45 CONTINUE 

C 

DO 47 I=JMrN+IDR,ND 
DO 48 11=1, NBP 
IF(I.EQ.IBAD(II)) ICB=ICB + 1 
48 CONTINUE 

47 CONTINUE 
C 

wt = REAL(ND-IDL-IDR-ICB) 


C 

WRITE(6,*) 'wt = ',wt 
WRITE(6,*) 'ICB = ',ICB 
C 

A(3,l)= SXF/ wt 
A(3,2)= SXC/ wt 
A(3,3)= SXS/ wt 
A(2,l)= SXC/ wt 
A(2,2)= SXS/ wt 


! set up a 3X3 matrix 
! to solve for the coeff 
! of the parabola 
! y=vl*x A 2 + v2*x + v3 


27 . 



c 


A(2,3)= SX / wt 
A(l,l)= SXS/ wt 
A(l,2)= SX / wt 
A(l,3)= 1. 

B(3)= SYXSQ/ wt 

B(2)= SYX/ wt ! the right side of the equation 

B(l)=SY/wt ! Av = B 

C 

DO 88 1=1, N 
DO 77 J=1,N 

WRITE(6,*)'A',I,J,'-,A(I,J) 

77 CONTINUE 

WRITE(6,*)'B',I, ,=, ,B(I) 

88 CONTINUE 
C 

D( 1 , 1 ) = 1. 

D(2,2) = 1 
D(3,3) = 1 . 

C 

U(l,l) = A(l,l) 

U(l,2) = A(l,2) ! STARTING THE LU DECOMPOSITION. 

U(l,3) = A(l,3) 

C 

D(2,l) = A(2,l)/A(l,l) 

U(2,2) = A(2,2) - D(2,1)*U(1,2) 

U(2,3) = A(2,3) - D(2, 1 )*U( 1 ,3) 

C 

D(3,l) = A(3,l)/U(l,l) 

D(3,2) = (A(3,2) - (D(3,1)*U(1,2)))/U(2,2) 

U(3,3) = A(3,3) - D(3,1)*U(1,3) - D(3,2)*U(2,3) 

C 

Q( 1 ) = B( 1 )/D( 1,1) ! THE LU BACK SUBSTITUTION. 

Q(2) = (B(2) - (D(2, 1 )*Q( 1 )))/D(2,2) 

Q(3) = (B(3) - (D(3, 1 )*Q( 1 )) - (D(3,2)*Q(2)))/D(3,3) 

C 

V(3) = Q(3)/U(3,3) 

V(2) = (Q(2) - (U(2,3)*V(3)))/U(2,2) ! COEFFICIENTS OF THE PARAB. 

V(l) = (Q(l) - (U(1,2)*V(2)) - (U(l,3)*V(3»yU(l,l) 

c 

V(3) = V(3)*(YMAX-YMIN) + YMIN 

V(2) = V(2)*(YMAX-YMIN) ! RESCALING THE COEFFICIENTS. 

V(l) = V(1)*(YMAX-YMIN) 

C 

DO 5 1=1, ND 
X(I) = REAL(I) 

5 CONTINUE 
C 

WRITE(6,'(///)’) 

WRITE(6,*)'THE EQUATION OF THE PARABOLA REMOVED FROM THE DATA IS' 
WRITE(6,’(//)') 

WRITE(6,*) 'Y=',V(1 )/X A 2+\V(2),'X+\V(3) 

C 

DO 6 J=1,ND 


n. 



n o 


C X(J) - X(J)*(REAL(ND- 1 )) + 1. 

YP(J) - V(1 )*(X(J)**2) + V(2)*X(J) + V(3) !eqn of the parabola 
DY(J) - Y(J) - YP(J) ! diff with the data 

6 CONTINUE 
C 

write(6,*yjMIN- ,JMIN,'X(JMIN)- ,X(JMIN), 

> ’Y(JMIN)- ,Y(JMIN), , YP(JMIN)- ,YP(JMIN) 
write(6,*yjMAX=\JMAX;X(JMAX)=\X(JMAXy 

> ’Y(JMAX)- ,Y(JMAX),'YP(JMAX)=\YP(JMAX) 
write(6,*) ’ymin - ,ymin/ymax - ,ymax 

write(6/(10F8.0)') DY 

YPMIN=YP(1) 

DO 7 J=2,ND 

IF( YPMIN.GT. YP(J)) THEN ! search for the minima of the parabola 
YPM1N = YP(J) 

JPMIN = J 
ENDIF 

7 CONTINUE 
C 

YPMAX=YP(1) 

DO 71 J=2,ND 

IF( YPMAX. LT.YP(J)) THEN ! search for the maxima of the parabola 
YPMAX = YP(J) 

JPMAX = J 
ENDIF 

71 CONTINUE 
C 

C if (ypmin.lt.ymin) ymin = ypmin ! set ymin to the lowest minima 

C if (ypmax.gt.ymax) ymax = ypmax ! set ymax to the highest maxima 

H = ymax - ymin 
C 

DO 8 1=1, ND 

Y(I) - Y(I)*(YMAX - YMIN) + YMIN 
YMP(I)= y(i)-yp(i)+YPMIN 
8 CONTINUE 
C 

C DO 99 1=1, ND 

C DO 92 11=1, NBP 

C IF( I.EQ.IBAD(II)) YMP(I) = (YMP(I-l) + YMP(I+l))/2. 

C 92 CONTINUE 
C 99 CONTINUE 
C 

WRITE(10/(A80y) AA 
WRITE(10;(A80y) BB 
WRITE(10,'(13I5,fl0.0y) M,F 
WRITE(I0;(7F10.2) ? ) FF 
WRITE(10;(10F7.0y) YMP 
WRITE( 1 0,’( 1 4I5)’)IBAD 
C 

DO 100 1=1, ND 

WRITE(6,'(F7.0,3X,F7.0,3X,F7.0,3X,F 10.0)') X(I),Y(I),YP(I),YMP(I) 
100 CONTINUE 
END 
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The following software represents a modification of 
code provided by Austin science into one that gives a 
the Moessbauer data which is ready for presentation. 


the computer 
final plot of 
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H0SSPL13.BAS 


February 2, 1996 


10 REH MOSSPLOT .BAS 

15 COLOR 1, 11 
20 CLS : KEY OFF 
22 LOCATE 2, 1 

25 PRINT "Adapted from a program by R.L. Collins, Austin 
Science Associates, Inc.," 

30 PRINT " Austin TX 78745" 

40 PRINT 11 Fall, 1995, version by E.J. Hoffman, Morgan 
State University Physics Dept." 

50 PRINT : PRINT : PRINT : PRINT : PRINT 

60 PRINT 11 Welcome to": 

PRINT 

65 PRINT M M 0 S S P L O 

T M : PRINT 

66 GOSUB 10050: REM Delay 

67 DIM Y (5 1 5 ) : DIM G(515): DIM M(515): DIM V< 1515) 

68 FQ$ = H FQ M : REM so that NEWFQS <>FG$ 

70 CLS 

72 ON KEY(10) GOSUB 10100: KEY(10) ON: REM Setting F10 for 
returning to the menu at any time 

73 PR = 0 

74 ON KEY(5) GOSUB 10160: KEY(5) ON: REM Setting F5 for 
use of the line printer 

75 LOCATE 10, 12: PRINT "IF YOU WISH THE LINE PRINTER TO 
RECORD THE OPERATION," 

76 PRINT: PRINT: PRINT " PRESS 

FUNCTION KEY F5" 

77 BEEP: GOSUB 10050: GOSUB 10050: CLS 

78 LOCATE 25, 8 

79 PRINT "TO RETURN TO THE MENU AT ANY TIME PRESS FUNCTION 
KEY F10 (Enter)" 

80 NUTEM$ = 1,11 : NEWFILES = DATS = "": BOXS = «" 

82 LOCATE 1, 35 

84 PRINT "MENU:": PRINT 

85 PRINT 11 1) Plot a theoretical curve from parameters 

given by the" 

86 PRINT " MOSS curve-fitting program (on the 

VAX)": PRINT 

90 PRINT " 2) Print out the data from 512-channel 

*.spm files created" 

91 PRINT " by the ASA-modified The Nucleus PCA": 

PRINT 

95 PRINT " 3) Create a .INP file for input into the 

MOSS program": PRINT 

100 PRINT " 4) For a *.spm file, calculate velocity 

from interferometer data;" 

101 PRINT " plot counts versus velocity" 

102 PRINT " 4') For a *.spm file run without the 

interferometer," 

103 PRINT " plot counts versus channel number": 

PRINT 

105 PRINT " 5) Overplot a fitted curve from parameters 

given by the MOSS program": PRINT 

107 PRINT " 6) Plot data points and overplot the 

fitted curve from a -DAT" 

108 PRINT " file downloaded from the VAX": PRINT 

110 PRINT » 7) Exit MossPlot" 

120 PRINT : INPUT " Enter your choice from the 

menu by number: ", NUTEMS 

124 ITEMS = NUTEMS 

125 ON ERROR GOTO 10300 

126 IF ITEMS <> "7" AND PR=1 THEN LPRINT : LPRINT " 

DATES; " TIMES; " MOSSPLOT Menu Choice: »; 

ITEMS: LPRINT 

127 ON ERROR GOTO 0 

129 PNTS% = 512: REM Item 6 may alter this 

130 IF ITEMS = "1" THEN CLS : GOTO 6000 

140 IF ITEMS = "2" THEN CLS : GOTO 1000 

150 IF ITEMS = "3" THEN CLS : GOTO 3000 

155 IF ITEMS = "4" THEN VELSTDS = " by interferometry" 

160 IF ITEMS = "4" OR ITEMS = "4'" THEN CLS : GOTO 6000 

170 IF ITEMS = "5" THEN CLS : BOXS = "DRAWN": GOTO 6180 

3 ; . 


180 IF ITEM$ = "6" THEN CLS : GOTO 2000 
190 IF ITEMS = "7" THEN CLS : GOTO 600 
200 GOTO 130 


600 CLS 

605 LOCATE 25, 2 

610 INPUT "Exit MOSSPLOT (yes, no)"; EXS 

620 IF EXS = "V" OR EXS = "y" THEN COLOR 7,0: CLS: END 

630 GOTO 70 

700 REM Loading a *.spm file 
702 IF FSS = "" THEN GOTO 720 

708 PRINT " Do you want to process FSS; " again 

(y, n)?» 

709 INPUT " ", RE FILES 

710 IF REFILES = "Y" OR REFILES = "y" THEN RETURN 
720 DIM X(4000): PRINT : 'PRINT: PRINT 

730 INPUT "Name of .spm file (you may type it without the 
.spai extension): ", NEWFILES 

732 PRINT : PRINT 

740 DGT = 1: REM Initializing at the first digit 

745 WHILE CHS <> CHRS(46) AND DGT < (LEN(NEWFILES) + 2): 

REM Up to the dot if there is one 

750 CHS = MID$(NEWFILES, DGT, 1): REM Filename 

character 

755 DGT = DGT + 1 
760 WEND 

762 NEWFQS = LEFTS(NEWFILES, DGT-2) : REM Filename without 
dot or extension 

764 IF NEWFQS = FQS THEN RETURN 

766 FQS = NEWFQS 

765 FSS = FQS + ".spm" 

767 ON ERROR GOTO 10175 

768 rem error 53 

770 OPEN FSS FOR RANDOM AS #1 LEN = 64 

772 ON ERROR GOTO 0 

775 FIELD #1, 64 AS AS 

780 GET #1, 1 

785 FOR I = 9 TO 40 

790 GET #1, I 

800 FOR J = 1 TO 64 

810 K = 64 * (I - 1) + J 

820 BS = MIDS(A$, J, 1) 

830 X(K) = ASC(BS) 

840 NEXT J 

845 NEXT I 

850 FOR I = 1 TO PNTS% 

860 N = 504 + 4 * 1 

870 Y(I) = X(N + 1) + 256 * (X(N + 2) + 256 * X(N + 

3)) 

880 NEXT I 
883 CLOSE #1 

885 FOR I = 1 TO 512 

886 IF Y(I) <> 0 GOTO 890 

887 NEXT I 

888 ERROR 53 

889 ON ERROR GOTO 0 

890 IF PR=1 THEN LPRINT : LPRINT "Data File Loaded: 

"; FSS: LPRINT 

900 RETURN 

1000 REH Raw data printout routine 
1010 GOSUB 700 

1440 FOR I = 1 TO 512 STEP 8 

1449 ON ERROR GOTO 10300 

1450 LPRINT USING "###»; I; 

1451 ON ERROR GOTO 0 

1460 FOR J = 0 TO 7 

1465 DIM A(512) 

1470 A( J) = Y( I + J) 

1480 LPRINT USING "######## "; A(J); 

1490 IF J = 7 THEN LPRINT »» 

1500 NEXT J 

1510 NEXT I 
1520 GOTO 70 

2000 REM Processing a *.DAT file 



M0SSPL13. BAS 


February 2, 1996 


2005 INPUT “Name of source (downloaded *.DAT) file: ", 

DATS 

2010 PRINT 

2015 FS$ = DATS 

2018 ON ERROR GOTO 10200 

2020 OPEN DATS FOR INPUT AS #2 

2021 ON ERROR GOTO 0 

2025 ENDJUNKS = "Al DATA": REM For experimental points 
2030 GOSUB 2800 

2035 GOSUB 2700: REM For baseline 

2055 PRINT: PRINT "Is this a europium run or an iron run? 
(Answer CHR$(34); "E"; CHRS<34); " or "; CHR$<34); "F"; 
CHRS<34); ")" 

2057 INPUT " ", EFS 

2060 IF EFS <> »E" AND EFS <> "e" AND EFS <> "F" AND EFS 
<> "f" THEN GOTO 12900 

2070 IF EFS = "F" OR EFS = "f» THEN VELSTDS = " relative 
to iron": STDEUS = GOTO 2100 

2071 VELSTDS = " relative to europium fluoride" 

2075 GOTO 12000 

2100 IF STDFES <> "" THEN INPUT "Want to use the same Fe 
standard run for calibration"; REPEATSTDS 
2103 IF REPEATSTDS = "Y" OR REPEATSTDS = "y" THEN GOTO 
2111 

2105 PRINT : PRINT "Name of Fe standard run for 

calibration" 

2110 PRINT » <"; CHRSC34); "Enter"; CHRS(34); : INPUT 

"if no calibration desired):", STDFES 

2111 PRINT : PRINT 

2130 IF STDFES = "» THEN GOTO 2410 

2135 ITEMS = "CAL6" 

2136 IF REPEATSTDS = "Y" OR REPEATSTDS = "y" THEN PRINT : 
GOTO 2287 

2137 dim pk(10) 

2140 READPKS = STDFES: GOSUB 2600 
2150 CALIBRFE = PEAK 

2155 IF VELSTDS = " relative to iron" AND STDFES <> "" 
THEN FSS = FSS ♦ ", calibrated using " + STDFES 
2160 IF STDEUS <> "" THEN FSS = FSS + ", calibrated using 
» + STDEUS + » and " + STDFES 

2170 IF PR=1 THEN LPRINT : LPRINT "Data File: "; FSS: 

LPRINT 

2180 IF STDEUS <> "" AND PR=1 THEN LPRINT "Peak of the Eu 
standard run is at channel "; CALIBREU 

2209 REM hyperfine splitting calculation follows 

2210 IF N = 6 THEN HFS = <<PK<6) - PK(4)) + (PK(3) - 

PK( 1 ))) / 4 

2215 IF N = 4 THEN HFS = <<PK(5) - PK<4)) + (PK(3) - 

PK(2))) / 2 

2220 PRINT : PRINT "Peak of the Fe standard run = the 
average of "; N; " positions = Channel "; CALIBRFE 
2225 IF PR=1 THEN LPRINT : LPRINT "Peak of the Fe standard 

run = the average of "; N; " positions = Channel "; 

CALIBRFE 

2230 PRINT : PRINT "The hyperfine splitting = the average 
of the spacings" 

2235 PRINT " between peaks 1-2, 2-3, 4-5, and 5-6 

= »; HFS; » channels" 

2240 IF PR=1 THEN LPRINT : LPRINT "The hyperfine splitting 
= the average of the spacings" 

2245 IF PR=1 THEN LPRINT « between peaks 1-2, 2-3, 

4-5, and 5-6 = "; HFS; " channels" 

2255 HFSSTD = 2.245: REM Standard HFS in mm/s 

2260 B = HFSSTD / HFS: REM Slope of the velocity vs. 
channel no. curve 

2261 PRINT : PRINT "The calibration constant = "; HFSSTD; 
"/"; HFS; » = "; B; " (mm/s) /channel" 

2262 IF PR=1 THEN LPRINT : LPRINT "The calibration 

constant = "; HFSSTD; "/»; HFS; " = "; B; " 

(mm/s)/channet" 

2263 PRINT : PRINT : IF PR=1 THEN LPRINT : LPRINT 
2265 IF EFS = "E" OR EFS = "e" THEN ISSTD = CALIBREU 
2267 IF EFS = "F" OR EFS = "f" THEN ISSTD = CALIBRFE 
2270 A = -B * ISSTD: C = 0: REM V = A + BX ♦ CX A 2; 


linearity assumed here 

2275 REM To get the isomer shift for the sample 
2282 READPKS = DATS 

2285 IF EFS = "E" OR EFS = "e" THEN GOSUB 12600 
2287 IF EFS = "F» OR EFS = «f» THEN GOSUB 2600 
2290 IS = B*(PEAK - ISSTD) 

2295 PRINT: PRINT "Isomer shift"; VELSTDS; » for » 

2296 PRINT " »; FSS; »:" 

2297 PRINT :PRINT " "; B; "X(";PEAK ; « - "; ISSTD; ") 

= »; IS; " mm/s" 

2300 IF PR=1 THEN LPRINT: LPRINT "Isomer shift"; VELSTDS; 
" for "; FSS; ": " 

2301 IF PR=1 THEN LPRINT " "; B; "X("; PEAK; " - 

ISSTD; ") = "; IS; « mm/s" 


2310 PRINT: PRINT " Do you want an extra 

x and y scale," 

2320 PRINT " for channel number and for 

counts," 

2330 PRINT " (answer "; CHR$(34); "n"; 

CHRS(34); " for a plot being" 

2340 PRINT " prepared for 

pub l i cation}" 

2350 INPUT " (y, n)“; SCALES* 

2360 IF SCALES* = "n" OR SCALES* = "N" THEN ITEM* = "PUB6" 
2365 IF YS = 0 OR SCALES* = "y" OR SCALES* = "Y" THEN GOTO 
2410 

2370 PRINT : PRINT " Would you like to re-use 

the same" 

2380 PRINT " Absorption axis scaling as in 

the" 

2390 PRINT " last plot, rather than an 

auto-" 

2400 INPUT " ical ly-maximi zed scale (y, 

n)"; REPEATSCS 
2405 PRINT : PRINT 
2410 GOSUB 6029 


2500 OPEN DAT* FOR INPUT AS #2 

2505 ENDJUNK* = "CAL FIT": REM For theoretical points 
2510 GOSUB 2800 
2520 CLOSE #2 

2590 ITEM* = "5": GOTO 6183 


2600 REM Reading peak positions and calculating average 
2603 ON ERROR GOTO 10225 

2605 OPEN READPK* FOR INPUT AS #3 

2606 ON ERROR GOTO 0 
2610 JUNK* = 1,11 

2615 WHILE RIGHT*! JUNK*, 6) <> "TO 0.5" 

2620 LINE INPUT #3, JUNK* 

2621 WEND 

2623 INPUT #3, JUNK 

2624 INPUT #3, JUNK 

2625 INPUT <13, JUNK 

2626 INPUT #3, JUNK 

2627 INPUT #3, JUNK 

2628 INPUT # 3, JUNK 
2630 INPUT #3, NRPARAMS 

2635 N = (NRPARAMS - 1)/3 

2636 IF N <> 6 AND N <> 4 THEN GOTO 10325 
2640 JUNK = 0 

2645 WHILE JUNK <> (1 + 2*N + 1) 

2650 INPUT #3, JUNK 

2655 WEND 

2680 FOR I = (4 - (N/2>) TO (3 + (N/2)) 

2683 INPUT #3, PK(I): INPUT #3, JUNK: INPUT #3, JUNK 

2685 NEXT I 

2686 CLOSE #3 

2687 PEAK = 0 

2688 FOR I = (4 - (N/2)) TO (3 + (N/2)) 

2689 PEAK = PEAK + PK( I ) 

2690 NEXT I 

2691 PEAK = PEAK / N: REM Isomer shift = avg. of N 
positions 

2699 RETURN 
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MOSSPl 1 3 . BAS 


February 2, 1996 


2700 REM Reading the converged baseline value 
2710 JUNK$ = 

2720 WHILE RIGHT$( JUNK$, 9) <> "DEVIATION" 

2730 LINE INPUT #2, JUNKS 

2740 WEND 

2750 INPUT #2, JUNK% 

2770 INPUT #2, B3 
2790 RETURN 

2800 REM Read- in loops 
2810 JUNKS = "" 

2820 WHILE RIGHTSl JUNKS, 7) <> ENDJUNKS 
2830 LINE INPUT #2, JUNKS 

2840 WEND 

2850 LINE INPUT #2, JUNKS : 'print » JUNKS = "; JUNKS 

2860 LINE INPUT M2, JUNKS : 'print " JUNKS = "; JUNKS 

2870 1=1: Y(0) = 1 

2880 'WHILE (Y(I) <> 0) OR <Y( I - 1 > <> 0) 

2885 FOR I = 1 TO PNTSX 
2890 INPUT M2, Y(I) 

2895 'print: print " I = ";I; " Y(I) = "; 

Y(I):rem ; " Yd-1) = Y< I -1 ) 

2896 'gosub 10050: 'gosub 10050: GOSUB 10050: GOSUB 

10050 

2898 'if (y(i)=0) and (y(i-1)=0) goto 2920 
2900 '1=1+1 

2910 next i: 'WEND 

2911 'gosub 10050 

2915 'print: print 11 I = ";I; " Y(I) = 

Yd); » Y(I-1) = »; Y(l-1) 

2920 'PNTSX =1-3 

2925 'print: print " PNTSX = »;PNTS% 

2930 RETURN 


3000 REM To save the data as a .INP file suitable for 
input into the MOSS program 

3010 YADDX = 0: REM Assume 6-digit counts until line 3124 
3020 GOSUB 700 

3030 FRS = FQS + ".INP": REM New filename is the same with 
".INP" instead of ".spm" 

3040 PRINT : PRINT : PRINT " A file is being 

saved suitable for input into the MOSS program." 

3050 PRINT : PRINT “ The new 

filename will be "; FRS 

3052 IF PS <> "" THEN GOTO 3700 

3060 PRINT "Type any description you wish to add to the 
filename (< 64 characters):" 

3070 PRINT: INPUT " ", DESCRS 

3080 PRINT : PRINT : INPUT " How many lines in the 

spectrum"; N 

3090 PRINT: PRINT " Enter estimated parameters (ENTER 
for zero spacers)": GOSUB 5100 
3100 OPEN FRS FOR OUTPUT AS #1 

3120 LSET EORFS = CHRS(13) + CHR$(10): REM Carriage retn. 
+ linefeed 

3121 YIJS = STRS(Y(105)): REM Counts in channel 105 used 
as a sample 

3122 REM The next line strips the space added by STRS from 
the left 

3123 YIJS = RIGHTS(YIJS, LEN(YIJS) - 1) 

3124 IF LEN(YIJS) = 7 THEN GOSUB 3500: REM For stripping 
off the first 1 

3140 PRINT #1, "1 (10F7.0)" 

3145 PRINT M\, CHRS(35); FQS; " "; DESCRS 

3150 PRINT #1. USING "MMMMM"; PNTSX; (15 + INTdPNTSX - 
5)/16)); 1; N; (3*N + 1); 0; 0; 0; 1; 1; 1; 0; 0; YADDX; 
3155 PRINT #1, "." 

3160 PRINT #1, USING " MMMMMM . "; B3; 

3165 FOR I = 1 TO N 
3167 AREA ! (I ) = -ABS(AREA! (I )) 

3170 PRINT #1, USING "MMMMMMM. "; AREA! (I ); 

3173 IF (1+1) = 7 THEN PRINT #1, EORFS 
3175 NEXT I 


3182 FOR J = 1 TO N 

3184 PRINT #1, USING “ MM.M "; LW!(J); 

3186 IF (1+N+J) = 7 OR ( 1+N+J ) = 14 OR (1+N+J) = 21 

THEN PRINT #1, EORFS 

3188 NEXT J 

3192 FOR K = 1 TO N 

3194 PRINT #1, USING "###. "; NRG! (K); 

3196 IF (1+(2*N)+K) = 7 OR (1 + (2*N)+K) = 14 OR 

(1+(2*N)+K) = 21 OR K = N THEN PRINT #1 , EORFS 
3198 NEXT K 

3200 FOR I = 1 TO PNTSX STEP 10 
3205 FOR J = 0 TO 9 

3210 IF (I + J) > PNTSX GOTO 3300 

3230 PRINT M\, USING "MMMMMM."; Y(I + J); 

3240 IF J = 9 THEN PRINT #1, EORFS 

3250 NEXT J 
3260 NEXT I 

3300 REM The following are NBADd), the channel numbers to 
be omitted by MOSS 
3310 PRINT Ml, EORFS 

3320 FOR I = 1 TO 14: REM Discarding the 1st 14 

points(non-data) 

3340 PRINT #1, USING "#####"; I; 

3350 NEXT I 

3360 PRINT #1, EORFS 

3365 K = 0: REM Counter for 14-digit lines 
3370 FOR I = 16 TO PNTSX STEP 16 
3380 PRINT #1, USING » MMMMM "; I; 

3385 K = K + 1 

3390 IF INT(K/14) = (K/14) THEN PRINT #1 , EORFS 
3400 NEXT I 

3470 CLOSE #1 
3480 FSS = "" 

3490 GOSUB 10000 
3495 GOTO 70 

3500 REM Routine for handling 7-digit counts 

3510 YADDX = 1 

3540 FOR I = 1 TO 512 

3550 YIS = STRS(Y(I)) 

3560 REM The next line strips the space added by STRS 

AND the 1 from the left 

3570 YIS = RIGHT$(YI$, LEN(YIS) - 2) 

3580 Y(I) = VAL (YIS) 

3590 NEXT I 
3600 RETURN 

3700 PRINT: PRINT "Would you like "; CHR$(34); PS; 

CHRS(34) 

3710 INPUT " to be printed as a description in the 

file"; PAGAINS 

3720 IF PAGAINS = "y" OR PAGAINS = "Y" THEN DESCRS = PS: 
GOTO 3080 
3730 GOTO 3060 

4000 REM Velocity formula calculation 
4005 'PRINT "PROGRAM ASSUMES 512 CHANNELS, FLYBACK MODE" 
4100 'PRINT “LASER MULTIPLEXES INTO EVERY 16TH CHANNEL" 
4140 'PRINT "TIMING INFO. ASSUMED:" 

4145 'PRINT " CH 9, ZERO VEL. IN CH 264" 

4150 'PRINT "IF NOT, CHANGE DATA IN LINE 4160." 

4159 'PRINT: PRINT: PRINT "Velocity formula calculation:" 

4160 A7 = 9: A9 = 264 

4170 N = 0: A0 = 0: A1 = 0: A2 = 0: A3 = 0: A4 = 0: A5 = 
0: A6 = 0 

4180 REM STARTING AND ENDING CH. NOS. ARE T1X AND T2X 
4190 T1X = 96: T2X = 432: REM, 8/95, Setup B reliable only 
in this range 
4200 Ml = Y(9) 

4240 B1 = 7.910248 

4250 FOR X = T1X TO T2X STEP 16 

4260 M = Y(X) 

4300 M = M * B1 / Ml 
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4310 IF X < A9 THEN 4330 

4320 GOTO 4340 

4330 M = -M 

4340 N = N + 1 

4350 AO = AO + X 

4360 A1 = A1 + X * X 

4370 A2 = A2 + M 

4380 A3=A3+X*X*X 

4390 A4 = A4 + X * M 

4400 A5=A5+X*X*X*X 

4410 A6=A6+X*X*M 

4420 NEXT X 

4430 REM NOW TO FIND PARAMETERS IN VEL(X)=A+BX+CXX 
4440 D = N * (A1 * A5 - A3 * A3) - AO * (AO * A5 - A1 * 
A3) + A1 * (AO * A3 - A1 * A1) 

4450 N1 = A2 * (A1 * A5 - A3 * A3) - AO * (A4 * A5 - A3 * 
A6) + A1 * (A4 * A3 - A1 * A6) 

4460 N2 = N * (A4 * A5 - A3 * A6) - A2 * (AO * A5 - A1 * 
A3) + A1 * (AO * A6 - A1 * A4) 

4465 N3 = N * (A1 * A6 - A3 * A4) - AO * (AO * A6 - A1 * 
A4) + A2 * (AO * A3 - A1 * A1 ) 

4470 A = N1 / D: B = N2 / D: C = N3 / 0 

4480 IF PR=1 THEN LPRINT »VEL(X)=»; A; "+ B; "*X+ C; 
"*X A 2" 

4481 IF PR=1 THEN LPRINT " where X is channel 

number" 

4483 IF PR=1 THEN LPRINT : LPRINT 

4484 PRINT "VEL(X)= A; "♦ »; B; "*X+ C; "*X A 2" 

4485 PRINT "where X is channel number" 

4487 PRINT : PRINT " NOTE THAT THE QUADRATIC 

COEFFICIENT IS PRINT 

4488 PRINT " C: PRINT 

4492 PRINT " For the best linearity the quadratic 

coefficient should vanish." 

4494 PRINT " Use the UltraLin program for easy 

adjustment of the ultralinear control." 

4500 RETURN: REM To line 6078 


5000 REM Routine for calculating Y(X), the fitted curve 

5001 CLS 

5005 T1X = 5: T2X = 511 

5010 PRINT : PRINT : INPUT "How many lines in the 

spectrum"; N 

5020 PI! = 4 * ATN(1): REM Pi = 4 X arctan(l) 

5030 PRINT: PRINT " Enter values from the converged 
curvefit: " 

5040 DIM YY(3 * N): DIM BB(3 * N): DIM ZZ(3 * N): DIM GG(3 
* N): DIM AA(3 * N, 6 * N) 

5050 'DIM NRG! (N) : DIM AREA! (N) : OIM LW! (N) 

5100 PRINT : PRINT : INPUT "Enter the baseline ", B3 

5101 IF PR=1 THEN LPRINT : LPRINT " Values 

entered:" 

5105 IF PR=1 THEN LPRINT : LPRINT "Baseline (counts): "; 

83 

5110 PRINT : PRINT : PRINT "Enter the parameters for each 
line:" 

5111 FOR I = 1 TO N 

5112 IF N = 1 THEN PRINT : GOTO 5120 

5115 PRINT : PRINT " For Line No. "; I; ":" 

5120 PRINT : INPUT " Absolute value of area under 
curve (channels X counts): ", AREA!(I) 

5130 PRINT : INPUT " Line width (channels): ", 

LW! (I ) 

5140 PRINT : INPUT " Position: Channel No. ", 

NRG! (I) 

5160 IF N = 1 THEN GOTO 5180 

5170 IF PR=1 THEN LPRINT : LPRINT " For Line No. 

11 * I 

5180 IF PR=1 THEN LPRINT : LPRINT " Absolute value 
of area under curve" 

5185 IF PR=1 THEN LPRINT " (channels 

X counts): ", AREA! (I) 

5190 IF PR=1 THEN LPRINT " Line width (channels): 

", LW! ( I ) 

5200 IF PR=1 THEN LPRINT " Position: Channel No. 

! 4 . 


", NRG! (I) 

5205 IF ITEM$="3" THEN GOTO 5250 

5210 YY(N + I) = NRG! (I) 

5230 YY(I ) = AREA! ( I ) / (PI! * LW! ( I ) ) : REM Assumes 
AREA! = PI X LW! X DEPTH OF DIP 

5240 YY(2 * N + I) = (LW!(I)) / 2: REM Austin's program 
uses half-width 
5250 NEXT I 

5255 IF ITEMS="3" THEN RETURN 

5260 FOR X = T1X TO T2%: REM Initializing Y(X) 

5280 Y(X) = 0 
5290 NEXT X 

5300 FOR X = T1X TO T2% 

5330 FOR I = 1 TO N 

5340 Y(X) = Y(X) + YY( I ) / (1 + (X - YY(N + I)) * (X 

- YY(N + I)) / (YY(2 * N + I) * YY(2 * N + I))) 

5350 NEXT I 

5360 Y(X) = B3 - Y(X) 

5370 NEXT X 

5380 RETURN 


6000 REM PLOT ROUTINE FOR HP 7440A COLORPRO PLOTTER 
6010 PRINT : PRINT : PRINT : PRINT 

6021 IF ITEMS = "1" THEN CLS : PRINT " Enter a title 
to be printed at the" 

6022 IF ITEMS = "1" THEN INPUT " upper left above the 
plot: ", FSS: GOTO 6031 

6025 GOSUB 700 

6029 PRINT: PRINT " »; CHR$(34); FSS; CHR$(34); 

6030 PRINT : PRINT " will be printed at the upper 

left above the plot." 

6031 PRINT : PRINT " Enter anything else you 

wish to appear as " 

6032 PRINT “ a subtitle ("; CHR$(34); 

"Enter"; CHRS(34); " for nothing else): " 

6033 PRINT : INPUT » ", PS 

6034 IF ITEMS = "1" THEN PRINT " FSS: 

GOSUB 5000 

6035 IF ITEMS = "CAL6" OR ITEMS = "PUB6" THEN GOTO 6080 
6037 IF ITEMS = "1" OR ITEMS = "6" OR ITEMS = "4'" THEN 
GOTO 6090 

6046 SOURCES = "Co-57": MATRIXS = "Rh": P2 = .14 

6047 PRINT : PRINT " NOTE: This program assumes a "; 
SOURCES; "source in a "; MATRIXS; " matrix:" 

6048 PRINT " velocity offset = "; P2; 

" mm/s“ 

6075 GOSUB 4000: REM For velocity formula 

6080 FOR X = 1 TO 1200 

6082 V(X) = A + B*X + C*X*X 

6084 NEXT X 

6085 P4 = INT(V(INT(.9 * (PNTSX)))) 

6086 IF P4 > 4 AND INT(P4 / 2) <> (P4 / 2) THEN P4 = P4 - 
1 

6087 IF P4 > 4 AND INT(P4 / 4) <> (P4 / 4) THEN P4 = P4 + 
2 

6088 IF P4 = 3 THEN P5 = 1 ELSE P5 = (P4) / 4: REM Max. 
vel. and tic spacing 

6090 PRINT : PRINT 

6091 PRINT " LOAD BLANK SHEET OF PAPER, AND SET 

SWITCH BOX TO "; CHR$(34); "A"; CHRS(34) 

6095 GOSUB 10000: PRINT : 'PRINT : 'PRINT : PRINT 
6160 PRINT : INPUT "IS PLOTTER READY (yes, no) "; AAS: REM 
Plot routine for curve or points 

6174 IF AAS = "N" OR AAS = "n" THEN CLS : GOTO 6090 

6175 CLS : LOCATE 9, 30 

6176 PRINT "PLOTTING "; FSS 

6180 IF ITEMS = "5“ THEN GOSUB 5000 

6182 ON ERROR GOTO 10275 

6183 OPEN "COM2:9600,S,7, 1 ,RS,CS65535,DS,CD" FOR RANDOM AS 
#1 

6184 ON ERROR GOTO 0 
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6185 GOSUB 9000: REM For plotter setup codes 

6186 IF ITEMS = "5" THEN GOTO 7000 
6188 PRINTIfl, "SP1"; 

6200 REM y axis scales 
6205 TU = 17 

6210 IF ITEMS <> “1" AND ITEMS <> "6" AND ITEMS <> "CAL6" 
AND ITEMS <> ''PUB6" THEN GOSUB 11000 

6220 IF ITEMS = "I" OR ITEMS = "6" OR ITEMS = "CAL6" OR 
ITEMS = ,, PUB6" THEN MAXCNT = B3: GOSUB 11065 

6290 REM For x axes 

6295 IF ITEMS = "1" OR ITEMS = "4'" OR ITEMS = "6" THEN 
GOTO 6340 

6300 P6 = -P4 

6301 'print "At line 6301, P4 = P4; ", and P6 = "; 

P6 

6302 'while inkeyS = "" 

6303 'wend 

6321 F3 = V(PNTSX) - V(T1X): REM For scaling x axis 

6322 REM F3 = B*(PNTSX-T1X) + C*(PNTSX A 2-20 A 2): REM 

Collins had F3 From 25 to PNTSX 

6323 WHILE P6 <= P4: REM New x-axis velocity labelling 
rout i ne 

6324 GOSUB 8600 

6325 P6 = P6 + P5 

6326 WEND: IF ITEMS = "PUB6" GOTO 6360 

6327 'FOR X = T1X TO T2X: REM Collins' routine 

6330 'IF (V(X) - P6) >= 0 THEN GOSUB 8900: REM x axis 
labelling with velocity 
6335 'NEXT X 

6340 PNTS2X = PNTSX - (PNTSX MOO 8) 

6345 FOR X = PNTS2X / 8 TO PNTSX STEP PNTS2X / 8 

6351 IF ITEMS = "1" OR ITEMS = "4'" OR ITEMS = "6" THEN 

GOSUB 8800: REM x axis labelling in Ch. No. 

6352 IF ITEMS = "4" OR ITEMS = "CAL6" THEN GOSUB 8700: 
REM Upper x axis labelling in Ch. No. 

6355 NEXT X 

6360 PRINT #1, "PA"; 1000; 7500; "DI1,0"; "LB"; "M.S.U. 
PHYSICS"; " "; DATES; " "; "Time: "; TIMES 

6362 PRINT #1, "PA"; 1000; 7200; "011, 0"; "LB"; FSS; " " 

6365 PRINT #1, "PA"; 1500; 7000; "011,0"; "LB"; PS; " " 

6367 IF ITEMS = "CAL6" THEN PRINT #1, "PA"; 2000; 6800; 
"Dll ,0"; "LB"; "Peak isomer shift = "; IS; " mm/s "; " " 

6370 GOSUB 10000 

6371 GOSUB 10000 

6380 IF ITEMS <> "PUB6" THEN PRINT #1 , "PA 10000 3500 
DIO, 1 LBCounts"; " " 

6382 GOSUB 10000 
6384 GOSU8 10000 

6390 PRINT #1, "PA 400 3000 DI0,1 LBPercent Absorption"; 

II II 

6392 GOSUB 10000 

6394 GOSUB 10000 

6395 IF ITEMS = "1" OR ITEMS = “4'" OR ITEMS = "6" THEN 
GOTO 6440 

6400 PRINT #1, "PA 3000 1400 DI1,0 LBVelocity in irm/sec"; 
VELSTDS 

6405 GOSUB 10000 
6410 GOSUB 10000 
6415 GOSUB 10000 

6420 IF ITEMS <> "PUB6" AND ITEMS <> "4'" THEN PRINT #1, 
"PA 4000 6400 011,0 LBChannel Number" 

6425 GOSUB 10000 
6430 GOSUB 10000 
6435 GOSUB 10000: GOTO 7000 

6440 PRINT #1, "PA 4000 1400 DI1,0 LBChannel Number" 

6450 GOSUB 10000 
6460 GOSUB 10000 
6470 GOSUB 10000 

7000 REM Point or curve plotting routine, from 6186, 6435, 
or 6470 

7010 FOR X = T1X TO PNTSX 

7020 IF ITEMS = "4" THEN GOTO 7030 

7022 REM G(X) , no interf. calibr. 


7023 G(X) = 1000 + 8000 * (X - T1%) / (PNTSX - T1%> 
7025 G(X) = INT(G(X)) 

7027 GOTO 7520 

7030 REM G(X) for interferometer-calibrated points 

7031 'print "At line 7031 P6 = "; P6 

7040 REM The next line skips the laser data 

7050 IF ((X - 16) / 16) = INT( (X - 16) / 16) THEN X = 

X + 1 

7060 IF P6 - ABS(V(X) ) >= 0 THEN G(X) = 5000 + INT(8000 
* V(X) / F3) 

7561 'print "At line 7561, X = »; X;", V(X) = "; V(X); 
", and G(X) = "; G(X) 

7562 'while inkeyS = »" 

7563 'wend 
7070 GOTO 7520 


7520 YF = Y(X) * CFB3 / B3: REM CFB3 = OldB3/YS (see 
line 11410) 

7530 M(X) = IDN + (((IUP - IDN) / (CFUP - CFDN)) * (YF 
- CFDN)) 

7532 NEXT X 

7535 IF ITEMS="1" OR ITEM$="5" THEN PRINT #1 ,"SP4;":GOSUB 
10000: REM Pen 4 for curve 

7538 FOR X = T1X TO PNTSX: REM Plotting 

7542 IF M(X) > 6000 OR M(X) < 2000 GOTO 7580 

7550 IF G(X) < 1000 OR G(X) > 9000 THEN 7580 

7560 IF ITEMS = "4" OR ITEMS = "4'" OR ITEMS = "6" OR 

ITEMS = "CAL6" OR ITEMS = "PUB6" THEN PRINT #1, "PA"; 

G(X); M(X); "PD PU;": GOTO 7580: REM For points 

7570 PRINT #1, "PA"; G(X); M(X); "PD"; : REM For curve 

7580 NEXT X 

7590 PRINT #1, "PU"; 

7592 REM Box drawing 

7693 IF BOX* = "DRAWN" THEN GOTO 7607 

7597 PRINT #1, "PA 1000 2000 PR PD 0 4000 8000 0 0 -4000 

-8000 0 PU PA;": REM Box drawing 

7605 BOXS = "DRAWN" 

7607 PRINT #1, "SPO;" 

7608 CLOSE #1: CLOSE #2 

7610 IF ITEMS = "6" OR ITEMS = "CAL6" OR ITEMS = "PUB6" 
THEN RETURN: REM to 2500 

7630 ERASE YY, BB, ZZ, GG, AA, AREA!, LW! , NRG!: GOTO 70 

8600 REM Subroutine from 6324 for lower x axis 

labelling in mm/s 

8610 I = 5000 + (8000 * (P6 - P2) / F3) 

8620 IF I < 1000 OR I > 9000 THEN RETURN 

8630 PRINT #1, "PA"; I; 2000; "PD"; I; 2100; "PU" 

8640 PRINT #1, "PA"; I - 100; 1800; "DI1,0"; "LB"; P6; 

II II 

8650 GOSUB 10000 

8660 GOSUB 10000 

8670 RETURN 

8700 REM Subroutine from 6352 for upper x axis labelling 
in Ch. No. 

8710 I = 5000 + <8000 * <V<X) - P2) / F3>: REM Same as 
8905, but no 11 1 NT" 

8720 IF I < 1000 OR I > 9000 THEN RETURN 

8730 PRINT #1, “PA”; I; 6000; "PD"; I; 5900; "PU" 

8740 PRINT #1, "PA"; I - 250; 6200; "DI1,0"; "LB"; X; 

ii it 

8750 GOSUB 10000 

8760 GOSUB 10000 

8770 RETURN 

8800 REM Subroutine from 6351 for lower x axis 

labelling in Ch. No. 

8810 I = 1000 + <8000 * <X * T1%) / <PNTS% - T1%)) 

8820 IF I < 1000 OR I > 9000 THEN RETURN 

8830 PRINT #1, "PA"; I; 2000; "PD"; I; 2100; "PU" 
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8840 

PRINT #1, "PA"; I - 100; 

1800; "Dll ,0"; "LB"; X; 

8850 

GOSUB 10000 


8860 

GOSUB 10000 


8870 

RETURN 


8900 

REM Collins' subroutine 

(unused) from line 6330 


for lower x. axis labelling in mm/s 

8905 I = 5000 + INK8000 * (V(X) - P2) / F3) 

8910 IF I < 1000 THEN 8950 

8920 IF I > 9000 THEN 8950 

8930 PRINT #1, "PA"; I; 2000; "PD"; I; 2100; "PU"; 

8940 PRINT <*1, "PA"; I - 100; 1800; “011,0"; "LB"; P6; 

II II 

8945 GOSUB 10000 

8946 GOSUB 10000 

8950 P6 = P6 + P5 

8970 RETURN 

9000 RESTORE: REM READing plotter codes 
9005 FOR X = 1 TO 6 
9010 READ « 

9020 PRINT #1, K$ 

9030 NEXT X 
9040 RETURN 

9050 DATA CHR$(27).CHR$(64);0: 

9060 DATA CHR$(27). 164; ; 17: 

9070 DATA CHRS(27).N;19: 

9080 DATA CHR$(27).J 
9090 DATA IN; 

9110 DATA DT 

10000 FOR J = 1 TO 10000 
10005 NEXT J 
10010 RETURN 

10050 FOR J = 1 TO 30000! 

10060 NEXT J 
10070 RETURN 

10075 FOR J = 1 TO 1000 
10080 NEXT J 
10085 RETURN 


10100 REM F10 key event handler from line 72 
10110 LOCATE 25, 1: 

10120 INPUT "Return to menu (yes, no)"; akeyS 

10130 IF akey$ = "Y" OR akey$ = "y" THEN ERASE YY, BB, ZZ, 

GG, AA. AREA!, LW! , NRG!: GOTO 70 

10140 LOCATE 25, 1: PRINT SPACE$(78): REM Deletes prompt 
10150 RETURN 

10160 REM F5 key event handler from line 74 
10165 PR = 1: RETURN 

10175 REM error handler for FS$ (line 770) 

10180 BEEP: PRINT: PRINT " "; FS$; " 

FILE NOT FOUND" 

10185 PRINT " (F10 to return to 

menu) 11 

10190 PRINT: RESUME 730 

10200 REM error handler for DATS (line 2020) 

10205 BEEP: PRINT: PRINT " "; DATS; " 

FILE NOT FOUND" 

10210 PRINT " ( F10 to return to 

menu)" 

10215 PRINT: RESUME 2005 

10225 REM error handler for READPKS = STDFES (line 2605) 
10230 BEEP: PRINT: PRINT " "; READPKS; 

“ FILE NOT FOUND" 

10235 PRINT " (F10 to return to 

menu) 11 

10240 PRINT: IF EFS = "E" OR EF$ = "e" THEN RESUME 12070 


10245 PRINT: IF EF$ = "F" OR EF$ = »f» THEN RESUME 2105 

10250 REM error handler for STDEUS (line 12605) 

10255 BEEP: PRINT: PRINT " STDEUS; 

" FILE NOT FOUND 1 ' 

10260 PRINT " (F10 to return to 

menu)" 

10265 PRINT: RESUME 12050 

10275 REM error handler for OPENing plotter (Line 6183) 
10280 CLS: LOCATE 9, 20 

10285 BEEP: PRINT "Plotter not responding: check switch 
box and connectors" 

10290 RESUME 6095 

10300 REM error handler for printer (line 126 and 1450) 
10305 CLS: LOCATE 9, 20 

10310 BEEP: PRINT " Printer not responding: check 

paper, power switch, connectors, etc." 

10315 PRINT: PRINT 11 Press the p key 

and RETURN when ready " 

10317 PRINT : INPUT " (RETURN only if you don't want 
the printer to record your operation)", PRINTS 

10320 IF PRINTS = "P" OR PRINTS = "p" THEN RESUME 

10321 IF PRINTS = "" OR PRINTS = "" THEN PR = 0: RESUME 


10325 CLOSE #3: REM Error handling from line 2636 
10340 PRINT: PRINT » FAULTY Fe 

STANDARD RUN!" 

10345 PRINT: PRINT " STDFE$; " shows N; " Lines and 
a total of NRPARAMS; " parameters." 

10350 PRINT " Choose an Fe standard run with 

4 or 6 lines." 

10355 PRINT: PRINT " Press F10 if you wish to 

return to the menu" 

10360 PRINT: PRINT: PRINT: CLOSE #3: GOTO 2410 

11000 REM The y axis scales: REM from line 6210 
11005 REM Setting the baseline to maximum counts 
11030 MAXCNT = 0 

11039 'print: print « At 11039 Tl%, PNTS%, MINCNT, 

MAXCNT = T1%; PNTSX; MINCNT; MAXCNT 

11040 FOR I = T1% TO PNTS% 

11045 'print "L i n e 1104 5" 


11050 

IF Y(I) > MAXCNT THEN MAXCNT 

= Y(I) 


11051 

'print: print 

" For I = "; i 

; ", Yd) 

H 

yd); " 

MAXCNT 

"; mAXcnt 



11052 

'gosub 10050: 

gosub 10050: 

GOSUB 10050 



11060 NEXT I 

11065 IF REPEATSCS = "Y" OR REPEATSCS = "y" THEN GOTO 
11500: REM from line 6220 

11067 IF ITEMS = "4" OR ITEMS = "4'" THEN B3 = MAXCNT 

11068 'print "MAXCNT = "; mAXcnt 

11069 MINCNT = MAXCNT 

11070 'print: print " MINCNT = "; mincnt 

11071 'gosub 10050: gosub 10050 

11072 FOR I = T1% TO PNTSX STEP 16 
11080 FOR J = I TO (I + 14) 

11085 IF J > PNTSX THEN GOTO 11120 

11090 IF Y(J) < MINCNT THEN MINCNT = Y(J) 

11091 'print: print " For I = i; " and J = "; j; ", 

Y( J) = "; y(j); " MINCNT = "; mincnt 

11092 'gosub 10050: gosub 10050: GOSUB 10050 

11100 NEXT J 

11101 'print: print " For I = "; i; " and J = "; j; ", 

Y(J) = "; y(j); " MINCNT = mincnt 

11102 'gosub 10050: gosub 10050: GOSUB 10050 

11110 NEXT I 

11120 MAXCNTS = STRS(MAXCNT) : MINCNTS = STRS(MINCNT) 

11124 REM The next line strips the space added by STRS 
from the left 

11125 MAXCNTS = RIGHTS(MAXCNTS, LEN(MAXCNTS) - 1): MINCNTS 
= RIGHTS(MINCNTS, LEN(MINCNTS) - 1) 

11130 MAXPNTX = INSTR(MAXCNT$, ".»): MINPNT% = 
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INSTRCMINCNTS, 

11140 IF MAXPNT% = 0 THEN MAXEXP% = LEN(HAXCNT$) - 1 ELSE 

MAYPYPY = MAYPMT% - 7 

11150 IF MINPNTX = 0 THEN MINEXPX = LEN(MINCNTS) - 1 ELSE 
MINEXPX = MINPNTX - 2 

11170 IF MAXEXPX <> MINEXPX THEN GOTO 11250 
11180 MAXDIGX = 1: MINDIGX =1: J = 0 

11185 WHILE MINDIGX = MAXDIGX 
11190 J = J + 1 

11200 MAXDIGX = VAl(MID$(MAXCNT$, J, 1)): MINDIGX = 
VAL(MID$(MINCNT$, J, D) 

11210 MEND 

11213 IF (MAXDIGX - MINDIGX) <= 1 THEN QX = 4: GOTO 11225 

11215 IF (MAXDIGX - MINDIGX) <= 2 THEN QX = 3: GOTO 11225 

11220 IF (MAXDIGX - MINDIGX) <= 4 THEN QX = 2 ELSE QX = 1 

11225 YS = 10 * (MAXEXPX + 2 - J - QX) 


11230 

CFUPS = 

LEFT$(MAXCNT$, 

J + QX - 

1): 

CFUP 

VAL(CFUP$): CFUP 

= CFUP + 1 




11240 

CFDN* = 

LEFT$(MINCNT$, 

J + QX - 

1): 

CFDN 


VAL(CFDNS) : GOTO 11290 

11250 REM Routine for wide count spread 

11260 DIFFX = MAXEXPX - MINEXPX 

11270 CFUPS = LEFT$(MAXCNT$, DIFFX + 1): CFUP = VAL(CFUPS) 
+ 1 

11280 CFDNS = LEFTS(MINCNTJ, 1): CFDN = VAL(CFDNS) 

11290 IUP = 5500: REM Highest tic on the right y axis 
(counts) 

11300 IDN = 2500 

11305 REM IUP - IDN = 3000 

11310 REM (IUP - IDN)/(CFUP - CFDN) = 3000/10 = 300 
11315 IF ITEMS = "PUB6" THEN GOTO 11400 

11317 CFSTEP = (CFUP - CFDN)/4 

11318 CFSTEP = INT(CFSTEP) 

11320 FOR CF = CFDN TO CFUP STEP CFSTEP: REM Right y axis 
(counts) 

11325 I = IDN + ({(IUP - IDN) / (CFUP - CFDN)) * (CF - 
CFDN)) 

11330 PRINT #1, "PA"; 8900; I; "PD"; 9000; I; "PU"; 
11340 PRINT #1, "PA"; 9020; (I - 10); "DI1,0"; "LB"; 
(CF * YS); " " 

11350 GOSUB 10000 
11360 NEXT CF 
11370 GOSUB 10000 


11590 GOSUB 10000 

11600 RETURN REM to line 6290 

12000 REM Eu standard 

12010 IF STDEUS <> "" THEN INPUT "Want to use the same Eu 
and Fe standard runs for calibration"; REPEUSTDS 
12030 IF REPEUSTDS = "Y" OR REPEUSTDS = "y" THEN GOTO 
12090 

12050 PRINT : PRINT "Name of Eu standard run for 

calibrating v = 0" 

12060 PRINT " ("; CHR$(34); "Enter"; CHR$(34); : INPUT 

"if no calibration desired): ", STDEui 

12065 IF STDEUS = "" THEN GOTO 2410 

12066 READPKS = STDEUS: GOSUB 12600 
12068 CALIBREU = PEAK 

12070 PRINT : PRINT "Name of Fe standard run for 

calibrating the v scale" 

12080 INPUT " (do not omit this): ", STDFES 

12090 PRINT : PRINT 
12200 GOTO 2135 

12600 REM Reading Eu peak position (from line 12066 or 
2285) 

12603 ON ERROR GOTO 10250 

12605 OPEN READPKS FOR INPUT AS #4 

12606 ON ERROR GOTO 0 
12610 JUNKS = 

12615 WHILE RIGHT$( JUNKS, 9) <> "DEVIATION" 

12620 LINE INPUT #4, JUNKS 

12621 WEND 

12640 JUNK = 0 
12645 WHILE JUNK <> 4 
12650 INPUT #4, JUNK 

12655 WEND 

12683 INPUT #4, PEAK 

12686 CLOSE #4 

12687 RETURN 

12900 PRINT: PRINT "This program can only process Eu and 
Fe runs (press F10 to return to menu)" 

12910 GOTO 2055 


11400 REM Left y axis (percent absorption) 

11410 ABSNUP2 = 1 - (YS * CFDN / B3) 

11413 IF ABSNUP2 <= .02 THEN ABSNUP3 = .02: GOTO 11470 
11417 IF ABSNUP2 < .05 THEN ABSNUP3 = ABSNUP2: GOTO 11470 
11420 ABSNUP3 = 0: K = 1 
11430 WHILE ABSNUP3 = 0 

11440 ABSNUP3 = (INT(ABSNUP2 * (10 * K))) / (10 A K) 
11450 K = K + 1 
11460 WEND 

11470 ABSNSP = (ABSNUP3) / 4 

11480 CFB3 = B3 / YS 

11485 CFUP3 = (CFB3) * (1 - ABSNUP3) 

11490 IUP3 = IDN + (((IUP - IDN) / (CFUP - CFDN)) * (CFUP3 
- CFDN)) 

11495 IF ABSNUP3 > .02 AND IUP3 > 2400 THEN ABSNUP3 = 

ABSNUP3 + ABSNSP 

11500 ABSN = 0 

11510 WHILE ABSN <= ABSNUP3 

11520 CF = (CFB3) * (1 - ABSN) 

11530 I = IDN + (((IUP - IDN) / (CFUP - CFDN)) * (CF - 
CFDN)) 

11535 IF I > 5800 OR I < 2200 THEN 11570 
11540 PRINT #1, “PA"; 1000; I; "PD"; 1100; I; "PU"; 
11550 PRINT #1, "PA"; 440; I; "DI1,0"; "LB"; (100 * 
ABSN); " " 

11560 GOSUB 10000 

11570 ABSN = ABSN + ABSNSP 

11575 IF ABSNUP3 > .02 THEN ABSN = (CINT(100*ABSN))/100: 
REM ABSN sometimes is ragged 

11580 WEND _ 
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PERSONNEL INVOLVED 


Frederick W. Oliver 
Professor - Physics Department 
Principal Investigator. 

Eugene Hoffman 

Assistant Professor -Physics Department 
Research Scientist 

Professor Hoffman was responsible for developing computer codes for 
plotting on a pc the data fit by the mainframe computer. He also 
assisted with many of the administrative duties of the grant. 

Richard Lockhart 

Professor - Prince Georges Community College 
Research Scientist 

Professor Lockhart worked on the project during the summer of 1995. 
He was responsible for ordering equipment and setting up the 
laboratory for making superconducting compounds. 

Christopher Brown 
Graduate student -UMCP 

Mr. Brown was responsible for assisting in the laboratory to make 
superconductng samples . 

Dereje Seifu, Lecturer - Physics Department 
Research Associate 

Dr. Seifu, a theoretical physicist , worked on developing software 
for analyzing experimental data on the mainframe computer. 

Zarfar Kureishy 
Research Associate 

Mr. Kureishy assisted with the many technical tasks associated with 
carrying out the objectives of the research. 

The students below assisted with analyzing data, writing 

software, and preparing samples for experimental measurements. 

Laura Gardner - Graduate student 

Aaron Bowman - Undegraduate student 

Grace Gregory - Undergraduate student 

Mia Nicholson - Undergraduate student 

Takisha Miller - Undergraduate student 

Lester Richardson - Undergraduate student 

Daryle Strickland - Undergraduate student 

Fritz Pierre - High school student 
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FINANCIAL STATUS REPORT 

(l onq F ortv) 


1 fedoiat Agency nod O 19.11 M/at»ooal fUnrimol 

In Which Report «s Submitted jjyy*p j Qjg ^ ^ 
AKUONAUTK'S AND STACK ADM I N I 

ST HAT I ON { i'J A S A ) 
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OMB Approval 
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1 

1 


0348-0039 
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.... 
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526002055 
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7. Basis 
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It). T ransactions: 

1 
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II 
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III 
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a. Intel outlays 
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$ 56,061.21 

$ 149,126.67 

b. Refunds, reflates, etc. 

-0- 
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- 0 - 

c. Program income used In accordance with Hie deduction alternative 
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d. Net outlays (Une a, less the sum of lines b and c) 
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36.061.21 
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- 0 - 
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||pi 

Bp 

ml 
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0 . Tolal lederai funds auttionzed for Hus funding period 
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Program Incoma, consisting of: 

q. Disbursed program income sliown on lines c and/or g above 


r. Disbursed program income using Hie addition alternative 


9 . Undisbuised program income 
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Expense 
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IAT I ON A I. AliWJNAUTICS AND Sl>A< E ADMIN 1ST RA 
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Homo , MORGAN STATE UNIVERSITY 
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Budget, No. 00-R I 
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PAYMENT 
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nr*!*'— . ~ 
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SAME 
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<5) 

(a) 

TOTAL 

(A* #/ date) 

a. Total program 

$149,126.67 

$ 

$ 
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b. Lott: Cumutatlva program Incoma 

-0- 



-o- 

e. Nat program outlays (Lme a «ww 

Jins 4) 

149,126.67 
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-0- 



-(> 
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149,126.67 
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f. Non-Federal share of amount on line e 
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i 
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agency for usa In mak- 
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1st month 
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2nd month 
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b. Lett: Estimated balance of Federal cash on hand as of beginning of advance period 

-0 
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